Experimental BBS Explossion 3/Experimental BBS Explossion III.iso/pascal/soundpas.zip/WAVEPLAY.PAS

Pascal/Delphi Source File | 1993-05-20 | 5KB | 211 lines

unit WavePlay;

{
  WavePlay
  Programmer: Charlie Calvert
  Date: March 1993

  Copyright (c) June 1993, by Charlie Calvert
  Feel free to use this code as an adjunct to your own programs.
}

interface

uses
  MMSystem, Objects, ODialogs, OWindows, PlayDlg,
  PlayerId, Strings, TimeName, WaveUnit, WinDos,
  WinTypes, WinProcs;

const
  DevStr = 'WaveAudio';

type
  PWaveDlg = ^TWaveDlg;
  TWaveDlg = Object(TPlayDialog)
      FileBox: PListBox;
      StatInfo, LenText, DevInfo, TimeLapsed: PStatic;
      EdCurDir: PEdit;
      TimeName: TTimeNameRec;
    constructor Init(AParent: PWindowsObject; AName: PChar);
    destructor Done; virtual;
    procedure SetUpWindow; virtual;
    procedure GetDetails;
    function GetTimeAndName: Boolean;
    procedure GetDirectoryInfo(var Msg: TMessage);
      virtual Wm_First + Wm_FillDir;
    procedure MciNotify(var Msg: TMessage);
      virtual wm_First + mm_MciNotify;
    procedure NewTimeName(var Msg: TMessage);
      virtual wm_First + wm_TimeName;
    procedure WaveAbort(var Msg: TMessage);
      virtual id_First + idAbort;
    procedure WavePause(var Msg: TMessage);
      virtual id_First + id_WavePause;
    procedure WavePlay(var Msg: TMessage);
      virtual id_First + id_WavePlay;
    procedure WaveFill(var Msg: TMessage);
      virtual id_First + id_WaveFill;
    procedure WaveRecord(var Msg: TMessage);
      virtual id_First + id_WaveRecord;
    procedure WmTimer(var Msg: TMessage);
      virtual wm_First + Wm_Timer;
  end;

implementation

constructor TWaveDlg.Init(AParent: PWindowsObject; AName: PChar);
begin
  inherited Init(AParent, AName);
  FileBox := New(PListBox, InitResource(@Self, id_WaveList));
  TimeLapsed := New(PStatic, InitResource(@Self, id_WaveNumTracks, MinLen));
  StatInfo := New(PStatic, InitResource(@Self, 125, MinLen));
  LenText := New(PStatic, InitResource(@Self, id_WaveLenInfo, MinLen));
  DevInfo := New(PStatic, InitResource(@Self, id_WaveDevInfo, MinLen));
  EdCurDir := New(PEdit, InitResource(@Self, id_WaveCurDir, MaxLen));
end;

destructor TWaveDlg.Done;
begin
  inherited Done;
  { CloseMci; }
end;

procedure TWaveDlg.SetUpWindow;
var
  Msg: TMessage;
begin
  inherited SetUpWindow;
  StrCopy(WildCard, '*.Wav');
  GetWindowsDirectory(CurrentDirectory, MaxLen);
  SetCurDir(CurrentDirectory);
  PostMessage(HWindow, Wm_FillDir, 0, 0);
end;

procedure TWaveDlg.GetDetails;
var
  S: array[0..MinLen] Of Char;
  Result: LongInt;
begin
  Result := GetLen;
  wvsPrintf(S, '%ld ms', Result);
  LenText^.SetText(S);
  Str(GetLocation, S);
  TimeLapsed^.SetText(S);
  DevInfo^.SetText(GetInfo(S));
end;

procedure TWaveDlg.GetDirectoryInfo(var Msg: TMessage);
var
  S: array[0..15] of Char;
begin
  SetCurDir(CurrentDirectory);
  StrCopy(S, '*.wav');
  if FileBox^.GetCount > 0 then FileBox^.ClearList;
  SendMessage(FileBox^.HWindow, LB_DIR, DDL_ARCHIVE, LongInt(@S));
  FileBox^.SetSelIndex(0);
  EdCurDir^.SetText(CurrentDirectory);
end;

procedure TWaveDlg.MciNotify(var Msg: TMessage);
begin
  GetDetails;
  Case Mode of
    Mci_Mode_Record: begin
      StatInfo^.SetText('Stopped');
      if (MessageBox(HWindow, 'Save file?', 'Question?',
                mb_YesNo or mb_IconQuestion) = idYes) then
      SaveFile(TimeName.FileName);
      CloseMci;
      Mode := Mci_Mode_Stop;
    end;
  else
    CloseMci;
  end;
  KillTimer(HWindow, PlayTimer);
end;

procedure TWaveDlg.WaveAbort(var Msg: TMessage);
begin
  CloseMci;
end;

procedure TWaveDlg.WavePlay(var Msg: TMessage);
var
  S1,
  Buf: array [0..MaxLen] of Char;
begin
  if (FileBox^.GetSelString(Buf, MaxLen) < 0) then begin
    MessageBox(HWindow, 'No file selected in listbox', '', mb_Ok);
    exit;
  end;
  StrCopy(S1, CurrentDirectory);
  StrCat(S1, '\');
  StrCat(S1, Buf);
  OpenMci(HWindow, S1, DevStr);
  SetTimeFormatMS;
  GetDetails;
  PlayMci;
  StartTimer;
end;

procedure TWaveDlg.WavePause(var Msg: TMessage);
begin
end;

procedure TWaveDlg.WaveFill(var Msg: TMessage);
var
  S: array[0..MaxLen] of Char;
  i: Integer;
begin
  EdCurDir^.GetText(S, MaxLen);
  StrCopy(CurrentDirectory, S);
  SendMessage(HWindow, WM_FillDir, 0, 0);
end;

procedure TWaveDlg.NewTimeName(var Msg: TMessage);
begin
  Move(PTimeNameRec(Msg.LParam)^, TimeName, SizeOf(TTimeNameRec));
end;

function TWaveDlg.GetTimeAndName: Boolean;
var
  D: PTimeNameDlg;
begin
  GetTimeAndName := True;
  StrCopy(TimeName.FileName, 'Foobar.Wav');
  D := New(PTimeNameDlg, Init(@Self, 'TimeName', TimeName));
  if Application^.ExecDialog(D) = idCancel then
    GetTimeAndName := False;
end;

procedure TWaveDlg.WaveRecord(var Msg: TMessage);
var
  Len: Word;
  S: array[0..MaxLen] of Char;
begin
  if not GetTimeAndName then Exit;
  if not OpenMci(HWindow, '', DevStr) then Exit;
  StatInfo^.SetText('Record');
  Len := TimeName.Time * 1000;
  wvsprintf(S, '%d', Len);
  LenText^.SetText(S);
  Mode := Mci_Mode_Record;
  SetTimeFormatMS;
  DoRecord(Len);
  StartTimer;
  Exit;
  StatInfo^.SetText('Stopped');
  if (MessageBox(HWindow, 'Save file?', 'Question?',
                mb_YesNo or mb_IconQuestion) = idYes) then
    SaveFile(TimeName.FileName);
  CloseMci;
end;

procedure TWaveDlg.WmTimer(var Msg: TMessage);
begin
  GetDetails;
end;
end.